type Atomo = (String, Char)       -- (premisas, hecho)
type LReglas = [(String, Atomo)]  --numero de regla y atomo
type Paso = (String, String)      --(variables a demostrar, numero regla)
type Recorrido = [Paso]
type Estado = (LReglas, [Recorrido], Recorrido)

-- si continua (Left) deberia devolver el estado actual, sino termina y devuelve el recorrido (Right)
type Continuacion = Either Estado Recorrido 

--TODO: arreglar que la primera vez guarda como un camino valido (["hecho", "R0"])
main :: IO ()
main = do putStr "Ingrese el nombre del archivo base: "
          filename <- getLine
          fileContents <- readFile (filename ++ ".txt")
          let lr = agregarNumRegla (map parseLine' $ lines fileContents)
          putStr ("Mi base de conocimiento: \n" ++ show lr)
          putStr "\nIngrese hecho a demostrar: "
          hecho <- getChar
          recorrido <- return [([hecho],"R0")]
          est_inicial <- return (lr,[recorrido],recorrido)
          dum <- return (procesar est_inicial) 
          (Right rec, est_final) <- whileM (\(cont, est_actual) -> either (const True) (const False) cont)
                (\(Left est_actual,(lr_int,caminos,rec)) -> do    
                        -- descomentar  los putStr para realizar un seguimiento de los cambios de variables      
                        --putStr ("\nrec: " ++ show rec)
                        -- el ultimo elemento del recorrido no tiene premisas, ej: ("", R5)
                        if(null (fst $ last rec)) then do
                         {- putStr ("\nHecho: " ++ (show (head $ fst $ head rec) ++ " verdadero!!"))
                          putStr "\nApriete una tecla para continuar"
                          c <- getChar
                          putStr ("\nBuscando alternativas para demostrar: " ++ show hecho)-}
                          return (procesar (lr_int, caminos++[rec], init rec))
                         else do
                          let hechoAct = (head $ fst $ last rec)
                          if(existeHecho hechoAct lr_int) then do
                              -- dado un hecho, lista reglas, y un numero regla
                              -- obtengo el par (premisas, numRegla) del hecho, donde el numero de regla
                              -- sea mayor al pasado por parametro
                              {-putStr ("\n\n1-Caminos: " ++ show caminos)
                              putStr ("\n2-Hecho actual: " ++ show hechoAct)
                              putStr ("\n3-Recorrido: " ++ show rec)
                              putStr ("\n3-Regla para 1 camino: " ++ show (snd $ last $ last caminos))
                              putStr ("\n3-Regla para 2 camino: " ++ show (obtenerReglaPasoAnterior rec caminos))
                              putStr ("\n3-Tamaño: " ++ show (length caminos))-}

                              -- * Ver obtencion de premisas
                              let premisasDelHecho = if(length caminos == 1) then
                                                        obtenerPremisasDelHecho hechoAct lr_int (snd $ last $ last caminos)
                                                      else
                                                        obtenerPremisasDelHecho hechoAct lr_int (obtenerReglaPasoAnterior rec caminos)
                              -- putStr ("\n4-Premisas del hecho: " ++ show premisasDelHecho)
                              let nuevoRec = if(fst premisasDelHecho == "*") then (init rec)
                                             else reemplazarNuevoHecho rec premisasDelHecho
                              --putStr ("\n5-Nuevo recorrido: " ++ show nuevoRec)
                              --ch <- getChar
                              -- devuelve el estado que tengo para seguir tratando de demostrar el hecho
                              return (procesar (lr_int, caminos, nuevoRec))
                          else do 
                            putStr ("\n\nEs verdadero: " ++ [hechoAct] ++ "? s/n \n")
                            h <- getChar
                            if (h == 's') then do
                              let lr_int_aux = agregarHecho hechoAct lr_int
                              putStr ("\nSe agrego un atomo a la base de conocimiento: \n" ++ show lr_int_aux)
                              return $ procesar $ (lr_int_aux, caminos, rec)
                            else do
                              let lr_int_aux = eliminarAtomo hechoAct lr_int
                              let rec_aux = eliminarAtomoRec hechoAct rec
                              return (procesar (lr_int_aux, caminos, rec_aux))
                ) dum
          -- snd' del estado es el recorrido
          -- tail del recorrido porque se guarda el recorrido inicial como primer camino:
          -- ['hecho', "R0"], y no es un camino no deberia aparecer como solucion          
          putStr ("\nCaminos encontrados: " ++ (show $ tail $ snd' est_final))
          putStr $ "\n\n\n" ++ mostrarCaminos (tail $ snd' est_final)
          return()

procesar :: Estado -> (Continuacion, Estado)
-- si el recorrido en el estado es vacio, termina el while y devuelve (Recorrido, Estado)
-- sino, devuelve (Estado, Estado) y continua el while
procesar (lr_int, caminos, rec) = if(null rec) then (Right rec, (lr_int, caminos, rec)) 
                                 else (Left (lr_int, caminos, rec), (lr_int, caminos, rec))

-- no pueden haber espacios despues de la ultima letra de un renglon, sino no toma bien la consecuencia
parseLine' :: String -> ([Char], Char)
parseLine' linea@(x:xs) = if (esHecho linea) then ([], head linea) 
                          else (obtenerPremisas linea, obtenerConsecuencia linea )

esHecho :: [Char] -> Bool
esHecho linea@(x:xs) = ('>' `elem` linea) == False

obtenerPremisas :: [Char] -> [Char]
obtenerPremisas linea@(x:xs) = separarPremisas ( takeWhile (/= '>') linea )

obtenerConsecuencia :: [a] -> a
obtenerConsecuencia linea@(x:xs) = last linea

separarPremisas :: [Char] -> [Char]
separarPremisas premisas@(x:xs) = [ a | a <- premisas, a /= ' ', a /= ',']


agregarNumRegla :: [Atomo] -> [ ([Char], Atomo) ] -- devuelve [ ( "RN°", ("premisas", 'c') ) ]
agregarNumRegla listAtomos@(x:xs) = [ ( (numRegla atomo listAtomos), atomo ) | atomo <- listAtomos]

numRegla :: Atomo -> [Atomo] -> String
numRegla atomo listAtomos@(x:xs) = "R" ++ show ((indice atomo listAtomos 0) + 1)

indice :: (Eq a) => a -> [a] -> Int -> Int

indice elemento [] n = -1

indice elemento (x:xs) n
    | x == elemento = n
    | otherwise = indice elemento xs (n+1)

existeHecho :: Char -> LReglas -> Bool

existeHecho hecho [] = False

existeHecho hecho (x:xs)
    | snd ( (snd x) ) == hecho = True
    | otherwise = existeHecho hecho xs


-- dado un hecho, devuelve el par (premisas, num_regla), 
-- el numero de regla del par, debe ser mayor al pasado por parametro
obtenerPremisasDelHecho :: Char -> LReglas -> String -> ([Char], String)

obtenerPremisasDelHecho hecho [] num_regla = ("*", "R*")

obtenerPremisasDelHecho hecho (x:xs) num_regla
    | ( (snd ( (snd x) ) == hecho) && (parseNumRegla (fst x) > (parseNumRegla num_regla)) ) = (fst $ snd x, fst x)
    | otherwise = obtenerPremisasDelHecho hecho xs num_regla

-- agrega al recorrido el par (pre, regla), pero sacando a pre todas las coincidencias de la cabeza de esas premisas
-- ej
-- reemplazarNuevoHecho [("z","R0"),("abcad","R1")] ("fg", "R2") -> [("z","R0"), ("fgbcd", "R2")]
reemplazarNuevoHecho :: Recorrido -> (String,String) -> Recorrido
reemplazarNuevoHecho rec@(x:xs) (pre, regla) = rec ++ [((pre ++ (tail $ fst $ last rec)), regla)]

-- quita todas las apariciones de un caracter de una lista 'a' "aabdasea" -> "bdse"
quitarApariciones :: Char -> String -> String
quitarApariciones char premisas@(x:xs) = [ a | a <- premisas, a /= char] 


-- obtiene el numero del string con el numero de regla: "R0" -> 0
parseNumRegla :: String -> Int
parseNumRegla regla = read (tail regla) :: Int


-- si hay un solo camino devuelve "R0" para poder usar cualquier regla
-- si el ultimo paso de mi recorrido no esta en el ultimo camino devuelve "R0"
-- si en mi recorrido hay alguna regla/paso nuevo que no aparece en mi recorrido devuelve "R0"
-- sino busco en el utlimo camino el ultimo elemento de mi recorrido, y devuelvo el numero de regla de ese paso
obtenerReglaPasoAnterior :: Recorrido -> [Recorrido] -> String
obtenerReglaPasoAnterior rec@(x:xs) caminos@(c:cs)
  | length caminos == 1 = "R0"
  | (indice (last rec) (last caminos) 0) < 0 = "R0"
  | hayNuevasReglas rec caminos = "R0"
  | otherwise = snd $ ( (last caminos) !! ((indice (last rec) (last caminos) 0)+1) )

-- se fija si algun paso de mi recorrido ya existe en el ultimo camino
hayNuevasReglas :: Recorrido -> [Recorrido] -> Bool
hayNuevasReglas rec@(x:xs) caminos@(c:cs)
  | indice x (last caminos) 0 < 0 = True
  | null xs = False
  | otherwise = hayNuevasReglas xs caminos

whileM :: Monad m => (a -> Bool) -> (a -> m a) -> (a -> m a)
whileM c mt x = if (c x) then (mt x) >>= whileM c mt else return x

-- funcion auxiliar para obtener el elemento de una tupla
snd' (x,y,z) = y

agregarHecho :: Char -> LReglas -> LReglas
agregarHecho hecho lr@(x:xs) = lr ++ [("R"++ (show $ length lr + 1), ("",hecho))]

eliminarAtomo :: Char -> LReglas -> LReglas
eliminarAtomo hecho lr@(x:xs) = [ a | a <- lr, (hecho `elem` (fst $ snd a)) == False]

eliminarAtomoRec :: Char -> Recorrido -> Recorrido
eliminarAtomoRec hecho rec@(x:xs) = [ a | a <- rec, (hecho `elem` (fst a)) == False]

mostrarCaminos [] = "No existen caminos - soluciones."

mostrarCaminos caminos@(x:xs)
  | not $ null xs = mostrarSubCaminos x ++ mostrarCaminos xs
  | otherwise = mostrarSubCaminos x

mostrarSubCaminos caminos@(x:xs)
  | not $ null xs = ((fst x) ++ " -> " ++ (mostrarSubCaminos xs))
  | otherwise = "*\n"